home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / pcboard / vrs501.zip / VRS.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1996-10-08  |  23KB  |  805 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Boolean  BOOLEAN001
  20.     Integer  INTEGER001
  21.     Integer  INTEGER002
  22.     Integer  INTEGER003
  23.     Integer  INTEGER004
  24.     Integer  INTEGER005
  25.     Integer  INTEGER006
  26.     Integer  INTEGER007
  27.     Integer  INTEGER008
  28.     Integer  INTEGER009
  29.     Integer  INTEGER010
  30.     Integer  INTEGER011
  31.     Integer  INTEGER012
  32.     Integer  INTEGER013
  33.     Integer  TINTEGER014(99)
  34.     String   STRING001
  35.     String   STRING002
  36.     String   STRING003
  37.     String   STRING004
  38.     String   STRING005
  39.     String   STRING006
  40.     String   STRING007
  41.     String   STRING008
  42.     String   STRING009
  43.     String   STRING010
  44.     String   STRING011
  45.     String   STRING012
  46.     String   STRING013
  47.     String   STRING014
  48.     String   STRING015
  49.     String   STRING016
  50.     String   STRING017
  51.     String   STRING018
  52.     String   TSTRING019(12)
  53.     String   STRING020
  54.     String   STRING021
  55.     String   STRING022
  56.     String   STRING023
  57.     String   STRING024
  58.     String   STRING025
  59.     String   STRING026
  60.     String   STRING027
  61.     String   STRING028
  62.     String   STRING029
  63.     String   TSTRING030(3)
  64.     String   STRING031
  65.     String   STRING032
  66.     String   STRING033
  67.     String   STRING034
  68.  
  69. ;------------------------------------------------------------------------------
  70.  
  71.     Goto LABEL001
  72.     End
  73.     If (0 == 0) STRING001 = "NO"
  74.     If (0 == 1) STRING001 = "YES"
  75.  
  76.     EndFunc
  77.  
  78.     :LABEL001
  79.     STRING025 = String(PcbNode())
  80.     If (PcbNode() == 0) STRING025 = "A"
  81.     STRING026 = String(Random(1000)) + "X" + STRING025
  82.     STRING014 = "@X01≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡@X0F"
  83.     STRING006 = "@X0C√@X07"
  84.     STRING005 = "@X0A√@X07"
  85.     STRING021 = "5.01"
  86.     INTEGER004 = ToInteger(Date())
  87.     STRING020 = FileInf(PPEPath() + PPEName() + ".PPE", 2)
  88.     STRING007 = "Virtual Reality Soldier v" + STRING021
  89.     Cls
  90.     If (Exist(PPEPath() + "ARMOR.DBF")) Goto LABEL002
  91.     Copy PPEPath() + "ARMOR.VRS", PPEPath() + "ARMOR.DBF"
  92.     PrintLn "@X40┌─────────────────────────────────────────────────────────────────────────────@X4C┐@X0F"
  93.     PrintLn "@X40│@X4B                             New Armor Database Created!@POS:79@@X4C│@X0F"
  94.     PrintLn "@X40└@X4C─────────────────────────────────────────────────────────────────────────────@X4C┘@X0F"
  95.     Delay (1 * 182) / 10
  96.     Cls
  97.     :LABEL002
  98.     If (Exist(PPEPath() + "WEAPONS.DBF")) Goto LABEL003
  99.     Copy PPEPath() + "WEAPONS.VRS", PPEPath() + "WEAPONS.DBF"
  100.     PrintLn "@X40┌─────────────────────────────────────────────────────────────────────────────@X4C┐@X0F"
  101.     PrintLn "@X40│@X4B                           New Weapons Database Created!@POS:79@@X4C│@X0F"
  102.     PrintLn "@X40└@X4C─────────────────────────────────────────────────────────────────────────────@X4C┘@X0F"
  103.     Delay (1 * 182) / 10
  104.     Cls
  105.     :LABEL003
  106.     If (Exist(PPEPath() + "USER.DBF")) Goto LABEL004
  107.     Copy PPEPath() + "USER.VRS", PPEPath() + "USER.DBF"
  108.     PrintLn "@X40┌─────────────────────────────────────────────────────────────────────────────@X4C┐@X0F"
  109.     PrintLn "@X40│@X4B                             New User Database Created!@POS:79@@X4C│@X0F"
  110.     PrintLn "@X40└@X4C─────────────────────────────────────────────────────────────────────────────@X4C┘@X0F"
  111.     Delay (1 * 182) / 10
  112.     Cls
  113.     :LABEL004
  114.     If (Exist(PPEPath() + "MUTANT.DBF")) Goto LABEL005
  115.     Copy PPEPath() + "MUTANT.VRS", PPEPath() + "MUTANT.DBF"
  116.     PrintLn "@X40┌─────────────────────────────────────────────────────────────────────────────@X4C┐@X0F"
  117.     PrintLn "@X40│@X4B                             New Mutant Database Created!@POS:79@@X4C│@X0F"
  118.     PrintLn "@X40└@X4C─────────────────────────────────────────────────────────────────────────────@X4C┘@X0F"
  119.     Delay (1 * 182) / 10
  120.     Cls
  121.     :LABEL005
  122.     Cls
  123.     STRING028 = GetToken()
  124.     If ((Upper(STRING028) == "BLT") || (Upper(STRING028) == "/BLT")) Goto LABEL022
  125.     If ((Upper(STRING028) == "MAINT") || (Upper(STRING028) == "/MAINT")) Goto LABEL023
  126.     If ((Upper(STRING028) == "DEBUG") || (Upper(STRING028) == "/DEBUG")) Then
  127.         If (((CurSec() >= SysopSec()) || OnLocal()) || Upper((U_Name() == "bob watson"))) DbgLevel 3
  128.     Endif
  129.     If (Exist(PPEPath() + "VRS-M15.PPE")) Goto LABEL006
  130.     STRING004 = "Required File Missing"
  131.     Goto LABEL024
  132.     :LABEL006
  133.     Call PPEPath() + "VRS-M15.PPE"
  134.     If (!Exist(PPEPath() + "VRS.DBF")) Call PPEPath() + "VRS-M81.PPE"
  135.     DOpen 3, PPEPath() + "VRS.DBF", 0
  136.     DTop 3
  137.     DGet 3, "MAINT", INTEGER005
  138.     INTEGER005 = ToInteger(INTEGER005)
  139.     DGet 3, "EMB_DATE", INTEGER006
  140.     INTEGER006 = ToInteger(INTEGER006)
  141.     DGet 3, "DDELETE", INTEGER002
  142.     DPut 3, "ACCESSED", DGet(3, "ACCESSED") + 1
  143.     DGet 3, "ACCESSED", INTEGER007
  144.     DClose 3
  145.     INTEGER003 = INTEGER004 - INTEGER006
  146.     Cls
  147.     Newline
  148.     PrintLn "@X02Please Wait...@X0F"
  149.     If (INTEGER005 < ToInteger(Date())) Call PPEPath() + "VRS-M80.PPE"
  150.     DOpen 0, PPEPath() + "USER.DBF", 0
  151.     DnCreate 0, PPEPath() + STRING026 + ".NDX", "NAME"
  152.     DTag 0, STRING026
  153.     DSeek 0, U_Name()
  154.     STRING024 = DRecNo(0)
  155.     SetEnv STRING025 + "RECNO=" + String(STRING024)
  156.     STRING027 = GetEnv(STRING025 + "RECNO")
  157.     STRING027 = ToInteger(STRING027)
  158.     DGet 0, "VITALITY", STRING023
  159.     If (STRING023 == "C") DPut 0, "VITALITY", "Y"
  160.     DPut 0, "PLAYED", DGet(0, "PLAYED") + 1
  161.     DnCloseAll 0
  162.     Delete PPEPath() + STRING026 + ".NDX"
  163.     STRING003 = Upper(ReadLine(PCBDat(), 29))
  164.     FOpen 1, STRING003, 0, 0
  165.     FSeek 1, 0, 0
  166.     FRead 1, STRING002, 25
  167.     FClose 1
  168.     If (Exist(PPEPath() + "UNIVERSL.KEY")) Then
  169.         Gosub LABEL026
  170.     ElseIf (Exist(PPEPath() + "UNI.KEY")) Then
  171.         Gosub LABEL027
  172.     Else
  173.         If (Exist(PPEPath() + PPEName() + ".KEY")) Goto LABEL007
  174.         BOOLEAN001 = 0
  175.         Goto LABEL008
  176.         :LABEL007
  177.         FOpen 2, PPEPath() + PPEName() + ".KEY", 0, 0
  178.         FGet 2, STRING008
  179.         FGet 2, STRING009
  180.         FGet 2, STRING010
  181.         FClose 2
  182.         If (Strip(Left(Upper(ReadLine(PCBDat(), 94)), 8), " ") <> "SURVIVAL") Then
  183.             If (Strip(Left(Upper(STRING009), 3), " ") <> Strip(Left(Upper(ReadLine(PCBDat(), 94)), 3), " ")) Then
  184.                 STRING004 = "BBS Name does *NOT* match keyfile"
  185.                 Goto LABEL024
  186.             Endif
  187.         Endif
  188.         STRING011 = Mid(STRING008, 2, 1)
  189.         STRING012 = Mid(STRING009, 5, 1)
  190.         STRING011 = Abs(Asc(STRING011) + 44 - 100)
  191.         STRING012 = Abs(Asc(STRING012) + 44 - 100)
  192.         If ((ToInteger(Mid(STRING010, 1, 2)) == ToInteger(Left(STRING011, 2))) && (ToInteger(Mid(STRING010, 79, 2)) == ToInteger(Left(STRING012, 2)))) Then
  193.             PrintLn STRING005
  194.             BOOLEAN001 = 1
  195.         Endif
  196.     Endif
  197.     :LABEL008
  198.     StartDisp 1
  199.     Print "@CLS@@X07"
  200.     PrintLn ""
  201.     PrintLn "      @X07┌┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┐"
  202.     PrintLn "      ├┼┼@X0F┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┘@X07┼┼┤"
  203.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70┌───────────────────────────────────────────────────────@X7F┐@X77┼@X08┼┼@X07┼┼┤"
  204.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70│                                       @X71                @X7F│@X77┼@X08┼┼@X07┼┼┤"
  205.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70│    ┌─────────────────────────────────────────────@X7F┐    │@X77┼@X08┼┼@X07┼┼┤"
  206.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70│    │                                             @X7F│    │@X77┼@X08┼┼@X07┼┼┤"
  207.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70│    │         @X71PRACTICAL COMPUTER SERVICES@X70         @X7F│    │@X77┼@X08┼┼@X07┼┼┤"
  208.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70│    │                                             @X7F│    │@X77┼@X08┼┼@X07┼┼┤"
  209.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70│    │            @X74 @X70    @X74  @X71PRESENTS@X70                  @X7F│    │@X77┼@X08┼┼@X07┼┼┤"
  210.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70│    │                                        @X7F     │    │@X77┼@X08┼┼@X07┼┼┤"
  211.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70│    └@X7F─────────────────────────────────────────────┘    │@X77┼@X08┼┼@X07┼┼┤"
  212.     PrintLn "      ├┼┼@X0F┼┼@X77┼@X70└@X7F───────────────────────────────────────────────────────┘@X77┼@X08┼┼@X07┼┼┤"
  213.     PrintLn "      ├┼┼@X0F┘@X08┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼@X07┼┼┤"
  214.     PrintLn "      └┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┘"
  215.     PrintLn ""
  216.     PrintLn "      @X0D▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄@X0F"
  217.     PrintLn "       @X8E", STRING007, "@POS:48@@X0B(c)1996 All Rights Reserved@X0F"
  218.     PrintLn "      @X0D▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀@X0F"
  219.     If (BOOLEAN001) Then
  220.         PrintLn "@X0B      REGISTERED TO:  @X0A", STRING008, "@X0B at @X0A", STRING009, "@X0F"
  221.         Newline
  222.         Delay 60
  223.     Else
  224.         If (BOOLEAN001) Goto LABEL009
  225.         PrintLn "                       @X8CUNREGISTERED EVALUATION COPY@X08"
  226.         Newline
  227.         INTEGER008 = 1
  228.         Color 15
  229.         For INTEGER008 = 10 To 1 Step -1
  230.             Print "                           DELAYING ", INTEGER008, " SECOND(S)..."
  231.             Delay 19
  232.             Backup 80
  233.         Next
  234.         Goto LABEL009
  235.     Endif
  236.     :LABEL009
  237.     If ((Upper(STRING028) == "TEST") || (Upper(STRING028) == "/TEST")) Goto LABEL011
  238.     MdmFlush
  239.     :LABEL010
  240.     DCloseAll
  241.     DOpen 0, PPEPath() + "USER.DBF", 0
  242.     DTop 0
  243.     Cls
  244.     PrintLn "@X04▄   ▄@X0F                                                 @X0C░▒              ▒░  @X0F"
  245.     PrintLn "@X04 ▀▄▀@X0C irtual Reality Soldier                           @X0C ░▒            ▒░   @X0F"
  246.     PrintLn "@X04───────────────────────────                            @X0C ░▒          ▒░    @X0F"
  247.     PrintLn "                                                        @X0C ░▒        ▒░     @X0F"
  248.     PrintLn "@X0ECopyright (c)1996 Practical Computer Services            @X0C ░▒ @X0B RS@X0C  ▒░      @X0F"
  249.     PrintLn "@X0EProgrammed by Bob Watson                                  @X0C ░▒    ▒░       @X0F"
  250.     PrintLn "@X0ECompiled: @X0B", STRING020, " @X0E Version:@X0B ", STRING021, "  @X0EAccesses:@X0B ", INTEGER007, "@POS:58@  @X0C ░▒  ▒░        @X0F"
  251.     If (INTEGER003 <= 1) Then
  252.         PrintLn "@X0ECurrent Game has been running:@X0B 1 @X0Eday@POS:61@@X0C ▒░▒░        @X0F "
  253.     Else
  254.         PrintLn "@X0ECurrent Game has been running:@X0B ", INTEGER003, " days@POS:61@@X0C ▒░▒░        @X0F "
  255.     Endif
  256.     PrintLn "@X0EPlayers are deleted after@X0B ", INTEGER002, "@X0E days of inactivity@POS:62@@X0C ░▒          @X0F"
  257.     If (BOOLEAN001) Then
  258.         PrintLn "@X0ERegistered to: @X0A", Trim(Left(STRING009, 35), " "), "@X0E  SysOp:@X0A ", STRING008
  259.     Else
  260.         PrintLn "@X0ERegistered to: @X8CUNREGISTERED BBS@X0E   SysOp: @X8CUNREGISTERED SYSOP!@X0F"
  261.     Endif
  262.     PrintLn "@X04══════════════════════════════════════════════════════════════════════════════@X0F"
  263.     PrintLn "@X0A(@X0DE@X0A)@X02nter Transporter"
  264.     PrintLn "@X0A(@X0DI@X0A)@X02nstructions"
  265.     PrintLn "@X0A(@X0DL@X0A)@X02ist Soldiers"
  266.     If ((CurSec() >= SysopSec()) || (Upper(U_Name()) == "bob watson")) PrintLn "@X0A(@X0DM@X0A)@X02aintenance Module"
  267.     PrintLn "@X0A(@X0DV@X0A)@X02RS Stats"
  268.     PrintLn "@X0A(@X0DQ@X02@X0A)@X02uit back to BBS"
  269.     Newline
  270.     STRING013 = ""
  271.     InputStr "Your Choice Soldier @X0A>@X0F _", STRING013, 10, 1, "EILMQV", 0 + 8
  272.     If (STRING013 == "") Goto LABEL010
  273.     Select Case (STRING013)
  274.         Case "E"
  275.             Goto LABEL012
  276.         Case "I"
  277.             Goto LABEL016
  278.         Case "L"
  279.             Gosub LABEL017
  280.             Goto LABEL010
  281.         Case "M"
  282.             If ((CurSec() < SysopSec()) && (Upper(U_Name()) <> "bob watson")) Goto LABEL010
  283.             DCloseAll
  284.             Call PPEPath() + "VRS-M99.PPE"
  285.             Goto LABEL010
  286.         Case "Q"
  287.             Goto LABEL025
  288.         Case "V"
  289.     End Select
  290.     :LABEL011
  291.     STRING031 = "NO"
  292.     STRING032 = "NO"
  293.     STRING033 = "NONE"
  294.     STRING034 = "N"
  295.     If (GrafMode() == "A") STRING033 = "No ANSI"
  296.     If (GrafMode() == "G") STRING033 = "Full ANSI"
  297.     If (GrafMode() == "R") STRING033 = "RIPscrip"
  298.     If (AnsiOn()) STRING031 = "YES"
  299.     If (OnLocal()) STRING034 = "YES"
  300.     Cls
  301.     StartDisp 1
  302.     PrintLn "@X70┌─────────────────────────────────────────────────────────────────────────────@X7F┐@X0F"
  303.     PrintLn "@X70│                           @X71  ╖  ╓ ╥─╖ ╓─╖  @POS:79@@X7F│@X0F"
  304.     PrintLn "@X70│ @X74Version: @X79", STRING021, "@POS:18@@X78──────────┐@X71  ╙╖╓╜ ║\╜ ╙─╖  @X78┌───────────  @X74Compiled: @X79", STRING020, "@POS:79@@X7F│@X0F"
  305.     PrintLn "@X70│                          @X78│@X71   ╙╜  ╙ ╙ ╙─╜  @X78│@X7F@POS:79@│@X0F"
  306.     PrintLn "@X70│                          @X78└────────────────┘@POS:79@@X7F│@X0F"
  307.     PrintLn "@X70│                      (c)1996 Practical Computer Services    @POS:79@@X7F│@X0F"
  308.     PrintLn "@X70│                      Programmed by: Bob Watson  @POS:79@@X7F│@X0F"
  309.     PrintLn "@X70└@X7F─────────────────────────────────────────────────────────────────────────────┘@X0F"
  310.     Newline
  311.     PrintLn "@X20┌─────────────────────────────────────────────────────────────────────────────@X2A┐@X0F"
  312.     PrintLn "@X20│ Free stack space: @X2F", StackLeft(), "@POS:38@@X20Current Debug Level·······: @X2F", DbgLevel(), "@POS:79@@X2A│@X0F"
  313.     PrintLn "@X20│ PCBoard Version·: @X2F", Ver(), "@POS:38@@X20Max Concurrent Players····: @X2F", MaxNode(), " @POS:79@@X2A│@X0F"
  314.     PrintLn "@X20│ System Time·····: @X2F", Time(), "@POS:38@@X20System Date···············: @X2F", Date(), " @POS:79@@X2A│@X0F"
  315.     PrintLn "@X20│ Graphics Mode···: @X2F", STRING033, "@POS:38@@X20ANSI On?··················: @X2F", STRING031, "@POS:79@@X2A│@X0F"
  316.     PrintLn "@X20│ Space Available·: @X2F", DriveSpace(PPEPath()), "@POS:38@@X20Local Mode?···············: @X2F", STRING034, "@POS:79@@X2A│@X0F"
  317.     PrintLn "@X20│ User············: @X2F", U_Name(), "@POS:38@@X20Security Level············: @X2F", CurSec(), "@POS:79@@X2A│@X0F"
  318.     PrintLn "@X20│ Minutes On······: @X2F", MinOn(), "@POS:38@@X20Minutes Left··············: @X2F", MinLeft(), "@POS:79@@X2A│@X0F"
  319.     PrintLn "@X20└@X2A─────────────────────────────────────────────────────────────────────────────┘@X0F"
  320.     PrintLn "@X20┌─────────────────────────────────────────────────────────────────────────────@X2A┐@X0F"
  321.     PrintLn "@X20│ System SysOp : @X2E", Trim(STRING002, " "), "@POS:38@@X20Key SysOp : @X2E", STRING008, "@POS:79@@X2A│@X0F"
  322.     PrintLn "@X20└@X2A─────────────────────────────────────────────────────────────────────────────┘@X0F"
  323.     Call PPEPath() + "VRS-M19.PPE"
  324.     If ((Upper(STRING028) == "TEST") || (Upper(STRING028) == "/TEST")) Goto LABEL025
  325.     Goto LABEL010
  326.     :LABEL012
  327.     Cls
  328.     DCloseAll
  329.     DOpen 0, PPEPath() + "USER.DBF", 0
  330.     DnCreate 0, PPEPath() + String(PcbNode()) + "-NU.NDX", "NAME"
  331.     DTop 0
  332.     DSeek 0, U_Name()
  333.     If (DChkStat(0) == 0) Goto LABEL013
  334.     DCloseAll
  335.     Delete PPEPath() + String(PcbNode()) + "-NU.NDX"
  336.     Call PPEPath() + "VRS-M98.PPE"
  337.     STRING026 = String(Random(1000)) + "X" + STRING025
  338.     DOpen 0, PPEPath() + "USER.DBF", 0
  339.     DnCreate 0, PPEPath() + STRING026 + ".NDX", "NAME"
  340.     DTag 0, STRING026
  341.     DSeek 0, U_Name()
  342.     STRING024 = DRecNo(0)
  343.     SetEnv STRING025 + "RECNO=" + String(STRING024)
  344.     STRING027 = GetEnv(STRING025 + "RECNO")
  345.     STRING027 = ToInteger(STRING027)
  346.     DnCloseAll 0
  347.     Delete PPEPath() + STRING026 + ".NDX"
  348.     Gosub LABEL020
  349.     :LABEL013
  350.     Print "@X0ADownloading your current Record.  Please wait."
  351.     DCloseAll
  352.     Delete PPEPath() + String(PcbNode()) + "-NU.NDX"
  353.     Call PPEPath() + "VRS-M1.PPE"
  354.     Gosub LABEL020
  355.     DPut 0, "ATT_DEF", " "
  356.     DPut 0, "MESSAGE", " "
  357.     DPut 0, "OPP_NODE", "0"
  358.     :LABEL014
  359.     DPut 0, "ONLINE", PcbNode()
  360.     Cls
  361.     DispFile PPEPath() + "DAILY.NWS", 2 + 1 + 4
  362.     PrintLn 
  363.     InputStr "           @X0CPress @X0E(@X04ENTER@X0E)@X0C to return or @X0E(@X04Y@X0E)@X0Cesterdays News Log @X0F_", STRING013, 11, 1, Mask_Ascii(), 0
  364.     If (Upper(STRING013) == "Y") Then
  365.         Cls
  366.         DispFile PPEPath() + "YESTER.NWS", 2 + 1 + 4
  367.         Newline
  368.         InputStr "        @X0C               Press @X0E(@X04ENTER@X0E)@X0C to return @X0F_", STRING013, 11, 1, Mask_Ascii(), 0
  369.     Endif
  370.     STRING022 = Mixed(DGet(0, "HANDLE"))
  371.     STRING015 = DGet(0, "VITALITY")
  372.     If ((STRING015 == "Y") || (STRING015 == "C")) Goto LABEL015
  373.     If (((STRING015 == "S") || (STRING015 == "B")) || (STRING015 == "I")) Then
  374.         DPut 0, "VITALITY", "Y"
  375.         DPut 0, "ONLINE", 0
  376.     Else
  377.         Newlines 2
  378.         PrintLn "@X0CYou have been killed, although this may be a disappointment for today, @X0F"
  379.         PrintLn "@X0Ctomorrow, you will be better for it.  See you then!@X0F"
  380.         Delay (5 * 182) / 10
  381.         Goto LABEL025
  382.     Endif
  383.     :LABEL015
  384.     Gosub LABEL020
  385.     Gosub LABEL021
  386.     Cls
  387.     PrintLn "@X1F@POS:15@ @X1FLIFE:@X1A ", Trim(DGet(0, "HITPTS_L"), " "), "  @X1FEXP:@X1A ", Trim(DGet(0, "EXP"), " "), "  @X1FCASH:@X1A ", Trim(DGet(0, "CASH"), " "), "  @X1FINFECTION:@X1A ", Trim(DGet(0, "INFECTED"), " "), "@X1F%@X1A", "@POS:79@@X0F"
  388.     If (DGet(0, "ATT_DEF") == "S") Then
  389.         PrintLn "@X1F Message: @X1C", Trim(DGet(0, "MESSAGE"), " "), "@X1F@POS:79@@X0F"
  390.         DCloseAll
  391.         Call PPEPath() + "VRS-M5.PPE"
  392.         Gosub LABEL020
  393.     Endif
  394.     Newlines 2
  395.     PrintLn "Virtual Reality Soldier - @X0ATop Level@X0F"
  396.     PrintLn STRING014
  397.     INTEGER001 = Random(4)
  398.     If (INTEGER001 == 0) PrintLn "@X0EThe shaftways are crowded with people rushing to get away...you push through.@X0F"
  399.     If (INTEGER001 == 1) PrintLn "@X0EFear is a smell that clings to your nostrils, people are afraid here!@X0F"
  400.     If (INTEGER001 == 2) PrintLn "@X0EThe turbo-shafts are strangely quiet right now, death hangs heavy in the air.@X0F"
  401.     If (INTEGER001 == 3) PrintLn "@X0EMutants have been seen in the east quarter, many deaths...                   @X0F"
  402.     If (INTEGER001 == 4) PrintLn "@X0EWatch your back, mutants are sneaky beasts...@X0F"
  403.     Newline
  404.     PrintLn "@X0A(@X0DT@X0A)@X02urbo-Shafts                              @X0A(@X0DM@X0A)@X02all               "
  405.     PrintLn "@X0A(@X0DR@X0A)@X02obotic Medic                             @X0A(@X0DV@X0A)@X02iew your stats    "
  406.     PrintLn "@X0A(@X0DO@X0A)@X02utpost                                   @X0A(@X0DB@X0A)@X02asic Training     "
  407.     PrintLn "@X0A(@X0DC@X0A)@X02entral Bank                              @X0A(@X0DL@X0A)@X02ist Soldiers      "
  408.     If (Exist(PPEPath() + String(DGet(0, "FILE_NUM")) + ".MSG")) Then
  409.         Print "@X0A(@X0DI@X0A)@X8Ansta-Mail @X02 "
  410.     Else
  411.         Print "@X0A(@X0DI@X0A)@X02nsta-Mail  "
  412.     Endif
  413.     PrintLn "                              @X0A(@X0DD@X0A)@X02aily News         "
  414.     PrintLn "@X0A(@X0DP@X0A)@X02layer Battles@X0A                            (@X0DE@X0A)@X02xamine Rankings "
  415.     PrintLn "@X0A(@X0DQ@X0A)@X02uit to Surface    "
  416.     Newline
  417.     InputStr "@X0A(@X02Hit an @X0A?@X02 for help@X0A) - @X0BYour Choice Soldier @X0A>@X0F _", STRING013, 10, 1, "TROVIPMBLDQCE?", 0 + 8
  418.     If (STRING013 == "") Goto LABEL015
  419.     Select Case (STRING013)
  420.         Case "T"
  421.             DCloseAll
  422.             Call PPEPath() + "VRS-M10.PPE"
  423.             Goto LABEL015
  424.         Case "M"
  425.             DCloseAll
  426.             Call PPEPath() + "VRS-M800.PPE"
  427.             Goto LABEL015
  428.         Case "R"
  429.             DCloseAll
  430.             Call PPEPath() + "VRS-M7.PPE"
  431.             Goto LABEL015
  432.         Case "C"
  433.             DCloseAll
  434.             Call PPEPath() + "VRS-M2.PPE"
  435.             Goto LABEL015
  436.         Case "I"
  437.             DCloseAll
  438.             Call PPEPath() + "VRS-M3.PPE"
  439.             Goto LABEL015
  440.         Case "O"
  441.             DCloseAll
  442.             Call PPEPath() + "VRS-M400.PPE"
  443.             Gosub LABEL020
  444.             If (DGet(0, "VITALITY") == "N") Then
  445.                 DPut 0, "ONLINE", 0
  446.                 Newline
  447.                 PrintLn "@X0CYou have been killed on your way to greatness.  Your name will not be lost, but@X0F"
  448.                 PrintLn "@X0Cyour time today is at an end.  Return tommorow, and see if the Robo-Medics were@X0F"
  449.                 PrintLn "@X0Cable to do anything with the few strands of DNA that were left.@X0F"
  450.                 PrintLn 
  451.                 Goto LABEL025
  452.             Endif
  453.             If (DGet(0, "VITALITY") == "C") Then
  454.                 DPut 0, "ONLINE", 0
  455.                 Cls
  456.                 Newline
  457.                 PrintLn "@X0BYour sleep is protected, but of course nothing is guaranteed in life@X0F"
  458.                 PrintLn "@X0BWhen you return, you will be thawed and restored to your Pre-Cryo @X0F "
  459.                 PrintLn "@X0Bstanding.  Enjoy your sleep!@X0F"
  460.                 Goto LABEL025
  461.             Endif
  462.             If (((DGet(0, "VITALITY") == "S") || (DGet(0, "VITALITY") == "I")) || (DGet(0, "VITALITY") == "B")) Then
  463.                 DPut 0, "ONLINE", 0
  464.                 Cls
  465.                 Newline
  466.                 PrintLn "@X0BYour sleep is protected, but of course nothing is guaranteed in life@X0F"
  467.                 PrintLn "@X0BOn your return, you will find out exactly how useful your sleeping chamber@X0F"
  468.                 PrintLn "@X0Bwas!  Enjoy your sleep!@X0F"
  469.                 Goto LABEL025
  470.             Endif
  471.             Goto LABEL015
  472.         Case "V"
  473.             DCloseAll
  474.             Call PPEPath() + "VRS-M1.PPE"
  475.             Goto LABEL015
  476.         Case "P"
  477.             DCloseAll
  478.             Call PPEPath() + "VRS-M12.PPE"
  479.             Goto LABEL015
  480.         Case "B"
  481.             DCloseAll
  482.             Call PPEPath() + "VRS-M11.PPE"
  483.             Goto LABEL015
  484.         Case "L"
  485.             Gosub LABEL017
  486.         Case "D"
  487.             Goto LABEL014
  488.         Case "?"
  489.             StartDisp 1
  490.             DispFile PPEPath() + "VRS-01.HLP", 2 + 1 + 4
  491.             Call PPEPath() + "VRS-M19.PPE"
  492.             Goto LABEL015
  493.         Case "Q"
  494.             Goto LABEL025
  495.         Case "E"
  496.             DCloseAll
  497.             Call PPEPath() + "VRS-M14.PPE"
  498.             Goto LABEL015
  499.     End Select
  500.     Goto LABEL015
  501.     :LABEL016
  502.     Cls
  503.     DispFile PPEPath() + "VRS.INS", 2 + 4 + 1
  504.     Call PPEPath() + "VRS-M19.PPE"
  505.     Goto LABEL010
  506.     :LABEL017
  507.     TSTRING019(1) = "Private"
  508.     TSTRING019(2) = "Corporal"
  509.     TSTRING019(3) = "Lance Corporal"
  510.     TSTRING019(4) = "Sergeant"
  511.     TSTRING019(5) = "Gunnery Sergeant"
  512.     TSTRING019(6) = "Lieutenant"
  513.     TSTRING019(7) = "Second Lieutenant"
  514.     TSTRING019(8) = "Captain"
  515.     TSTRING019(9) = "Major"
  516.     TSTRING019(10) = "Colonel"
  517.     TSTRING019(11) = "Lieutenant Colonel"
  518.     TSTRING019(12) = "General"
  519.     Cls
  520.     Newlines 2
  521.     PrintLn "            @X0ERank               @X0AName                    @X0B Life Status"
  522.     PrintLn "            @X09───────────────────────────────────────────────────────"
  523.     DCloseAll
  524.     DOpen 0, PPEPath() + "USER.DBF", 0
  525.     DTop 0
  526.     If (DEof(0)) Return
  527.     :LABEL018
  528.     If (DEof(0)) Goto LABEL019
  529.     DSkip 0, 1
  530.     STRING016 = Trim(TSTRING019(DGet(0, "LEVEL")), " ")
  531.     STRING017 = Trim(DGet(0, "HANDLE"), " ")
  532.     STRING018 = Trim(DGet(0, "VITALITY"), " ")
  533.     STRING017 = Mixed(STRING017)
  534.     If ((((STRING018 == "Y") || (STRING018 == "S")) || (STRING018 == "B")) || (STRING018 == "I")) STRING018 = "   @X0BALIVE@X0F"
  535.     If (STRING018 == "N") STRING018 = "   @X0CDEAD@X0F"
  536.     If (STRING018 == "C") STRING018 = "@X03CRYO-CORPSE@X0F"
  537.     PrintLn "@POS:13@@X0E", STRING016, "@POS:32@@X0A", STRING017, "@POS:57@", STRING018
  538.     Goto LABEL018
  539.     :LABEL019
  540.     DCloseAll
  541.     Newline
  542.     Call PPEPath() + "VRS-M19.PPE"
  543.     Gosub LABEL020
  544.     Return
  545.     Cls
  546.     DispFile PPEPath() + "VRS-01.HLP", 2 + 4 + 1
  547.     DispFile PPEPath() + "VRS-02.HLP", 2 + 4 + 1
  548.     DispFile PPEPath() + "VRS-03.HLP", 2 + 4 + 1
  549.     Call PPEPath() + "VRS-M19.PPE"
  550.     Goto LABEL015
  551.     :LABEL020
  552.     DCloseAll
  553.     DOpen 0, PPEPath() + "USER.DBF", 0
  554.     DGo 0, STRING027
  555.     Return
  556.     :LABEL021
  557.     Gosub LABEL020
  558.     If (DGet(0, "HITPTS_L") == 0) Then
  559.         Newlines 1
  560.         PrintLn "@X0CYou have been killed on your way to greatness.  Your name will not be lost, but@X0F"
  561.         PrintLn "@X0Cyour time today is at an end.  Return tommorow, and see if the Robo-Medics were@X0F"
  562.         PrintLn "@X0Cable to do anything with the few strands of DNA that were left.@X0F"
  563.         PrintLn 
  564.         DPut 0, "ONLINE", 0
  565.     Else
  566.         Return
  567.         :LABEL022
  568.         If ((CurSec() >= SysopSec()) || OnLocal()) Then
  569.             DCloseAll
  570.             FCloseAll
  571.             Call PPEPath() + "VRS-M16.PPE"
  572.             :LABEL023
  573.         ElseIf (((CurSec() >= SysopSec()) || OnLocal()) || Upper((U_Name() == "bob watson"))) Then
  574.             DCloseAll
  575.             FCloseAll
  576.             Call PPEPath() + "VRS-M80.PPE"
  577.         Else
  578.             :LABEL024
  579.             Cls
  580.             Newlines 2
  581.             PrintLn "@X10┌─────────────────────────────────────────────────────────────────────────────@X19┐@X0F"
  582.             PrintLn "@X10│@X9C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @X19│@X0F"
  583.             PrintLn "@X10│@X9C !!!!!                                                                 !!!!! @X19│@X0F"
  584.             PrintLn "@X10│@X9C !!!!!    @X1E One or more of the VRS modules has been tampered with.     @X9C !!!!! @X19│@X0F"
  585.             PrintLn "@X10│@X9C !!!!!    @X1E VRS will not continue, please obtain an original archive   @X9C !!!!! @X19│@X0F"
  586.             PrintLn "@X10│@X9C !!!!!    @X1E From the PCS Support BBS listed in the VRS documentation.  @X9C !!!!! @X19│@X0F"
  587.             PrintLn "@X10│@X9C !!!!!                                                                @X9C !!!!! @X19│@X0F"
  588.             PrintLn "@X10│@X9C !!!!!    @X1E Decompilation of copyrighted works is a U.S. Federal       @X9C !!!!! @X19│@X0F"
  589.             PrintLn "@X10│@X9C !!!!!    @X1E crime, and punishable by up to 10 years in prison and      @X9C !!!!! @X19│@X0F"
  590.             PrintLn "@X10│@X9C !!!!!    @X1E a $100,000 fine.                                           @X9C !!!!! @X19│@X0F"
  591.             PrintLn "@X10│@X9C !!!!!                                                                @X9C !!!!! @X19│@X0F"
  592.             PrintLn "@X10│@X9C !!!!!    @X1E Support shareware! This is how we put food on our tables   @X9C !!!!! @X19│@X0F"
  593.             PrintLn "@X10│@X9C !!!!!    @X1E and clothes on our childrens backs.  Thank you!            @X9C !!!!! @X19│@X0F"
  594.             PrintLn "@X10│@X9C !!!!!                                                                 !!!!! @X19│@X0F"
  595.             PrintLn "@X10│@X9C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @X19│@X0F"
  596.             PrintLn "@X10└@X19─────────────────────────────────────────────────────────────────────────────┘@X0F"
  597.             PrintLn STRING004
  598.             Delay (360 * 182) / 10
  599.             Goto LABEL025
  600.         Endif
  601.     Endif
  602.     :LABEL025
  603.     DCloseAll
  604.     FCloseAll
  605.     DbgLevel 0
  606.     End
  607.     :LABEL026
  608.     FOpen 1, PPEPath() + "UNIVERSL.KEY", 0, 0
  609.     FDefIn 1
  610.     For INTEGER012 = 1 To 3
  611.         FDGet TSTRING030(INTEGER012)
  612.     Next
  613.     FClose 1
  614.     STRING029 = TSTRING030(1) + TSTRING030(2)
  615.     STRING029 = Strip(STRING029, " ")
  616.     For INTEGER013 = 1 To Len(STRING029)
  617.         TINTEGER014(INTEGER013) = Asc(Mid(STRING029, INTEGER013, 1))
  618.     Next
  619.     INTEGER010 = 0
  620.     For INTEGER013 = 1 To 99
  621.         INTEGER010 = INTEGER010 + TINTEGER014(INTEGER013)
  622.     Next
  623.     INTEGER011 = INTEGER010 * 659
  624.     INTEGER009 = INTEGER011
  625.     BOOLEAN001 = 0
  626.     If (INTEGER011 <> TSTRING030(3)) Then
  627.         BOOLEAN001 = 0
  628.     Else
  629.         BOOLEAN001 = 1
  630.         STRING008 = TSTRING030(1)
  631.         STRING009 = TSTRING030(2)
  632.     Endif
  633.     Return
  634.     :LABEL027
  635.     FOpen 1, PPEPath() + "UNI.KEY", 0, 0
  636.     FDefIn 1
  637.     For INTEGER012 = 1 To 3
  638.         FDGet TSTRING030(INTEGER012)
  639.     Next
  640.     FClose 1
  641.     STRING029 = TSTRING030(1) + TSTRING030(2)
  642.     STRING029 = Strip(STRING029, " ")
  643.     For INTEGER013 = 1 To Len(STRING029)
  644.         TINTEGER014(INTEGER013) = Asc(Mid(STRING029, INTEGER013, 1))
  645.     Next
  646.     INTEGER010 = 0
  647.     For INTEGER013 = 1 To 99
  648.         INTEGER010 = INTEGER010 + TINTEGER014(INTEGER013)
  649.     Next
  650.     INTEGER011 = INTEGER010 * 659
  651.     INTEGER009 = INTEGER011
  652.     BOOLEAN001 = 0
  653.     If (INTEGER011 <> TSTRING030(3)) Then
  654.         BOOLEAN001 = 0
  655.     Else
  656.         BOOLEAN001 = 1
  657.         STRING008 = TSTRING030(1)
  658.         STRING009 = TSTRING030(2)
  659.     Endif
  660.     Return
  661.  
  662. ;------------------------------------------------------------------------------
  663. ;
  664. ; Usage report (before postprocessing)
  665. ;
  666. ; ■ Statements used :
  667. ;
  668. ;    2       End
  669. ;    19      Cls
  670. ;    1       Color 
  671. ;    136     Goto 
  672. ;    103     Let 
  673. ;    5       Print 
  674. ;    127     PrintLn 
  675. ;    87      If 
  676. ;    7       DispFile 
  677. ;    4       FOpen 
  678. ;    4       FClose 
  679. ;    3       FGet 
  680. ;    3       StartDisp 
  681. ;    4       Delete 
  682. ;    4       InputStr 
  683. ;    12      Gosub 
  684. ;    6       Return
  685. ;    8       Delay 
  686. ;    12      Newline
  687. ;    5       Newlines 
  688. ;    24      Call 
  689. ;    1       Backup 
  690. ;    2       DbgLevel 
  691. ;    1       FSeek 
  692. ;    1       FRead 
  693. ;    2       FDefIn 
  694. ;    2       FDGet 
  695. ;    4       Copy 
  696. ;    1       MdmFlush
  697. ;    2       SetEnv 
  698. ;    3       FCloseAll
  699. ;    1       EndFunc
  700. ;    7       DOpen 
  701. ;    1       DClose 
  702. ;    22      DCloseAll
  703. ;    3       DnCreate 
  704. ;    2       DnCloseAll 
  705. ;    4       DTop 
  706. ;    1       DGo 
  707. ;    1       DSkip 
  708. ;    2       DTag 
  709. ;    3       DSeek 
  710. ;    5       DGet 
  711. ;    13      DPut 
  712. ;
  713. ;
  714. ; ■ Functions used :
  715. ;
  716. ;    3       -
  717. ;    8       *
  718. ;    6       /
  719. ;    120     +
  720. ;    3       -
  721. ;    69      ==
  722. ;    5       <>
  723. ;    9       <
  724. ;    8       <=
  725. ;    18      >=
  726. ;    57      !
  727. ;    16      &&
  728. ;    26      ||
  729. ;    4       Len(
  730. ;    19      Upper()
  731. ;    6       Mid()
  732. ;    6       Left()
  733. ;    4       Asc()
  734. ;    10      Trim()
  735. ;    3       Random()
  736. ;    3       Date()
  737. ;    1       Time()
  738. ;    8       U_Name()
  739. ;    1       Ver()
  740. ;    5       Strip()
  741. ;    9       String()
  742. ;    2       Mask_Ascii()
  743. ;    3       PCBDat()
  744. ;    68      PPEPath()
  745. ;    6       PcbNode()
  746. ;    3       ReadLine()
  747. ;    5       SysopSec()
  748. ;    4       OnLocal()
  749. ;    6       CurSec()
  750. ;    1       GetToken()
  751. ;    1       MinLeft()
  752. ;    1       MinOn()
  753. ;    2       GetEnv()
  754. ;    10      Exist()
  755. ;    1       AnsiOn()
  756. ;    2       Abs()
  757. ;    3       GrafMode()
  758. ;    1       FileInf()
  759. ;    3       PPEName()
  760. ;    1       MaxNode()
  761. ;    1       DbgLevel()
  762. ;    10      ToInteger()
  763. ;    2       Mixed()
  764. ;    1       DriveSpace()
  765. ;    1       StackLeft()
  766. ;    2       DEof()
  767. ;    2       DRecNo()
  768. ;    20      DGet()
  769. ;    1       DChkStat()
  770. ;
  771. ;------------------------------------------------------------------------------
  772. ;
  773. ; Analysis flags : Cds
  774. ;
  775. ; C - Call child PPE ■ 3
  776. ;     This is usually normal, but may be a tricky way to launch some
  777. ;     sysop-only commands.
  778. ;     ■ Search for : CALL
  779. ;
  780. ; d - Access PCBOARD.DAT ■ 2
  781. ;     Program gets the full pathname to PCBOARD.DAT, this may be usefull
  782. ;     for many PPE so they can find various informations on the system
  783. ;     (system paths, max number of lines in messages, ...) but it may also
  784. ;     be a way to gather vital informations.
  785. ;     ■ Search for : PCBDAT()
  786. ;
  787. ; s - Sysop level access ■ 5
  788. ;     Program is reading the sysop access level, this may be normal
  789. ;     but still it is very suspect. It is the best way to give a user
  790. ;     all priviledges. Check!
  791. ;     ■ Search for : SYSOPSEC()
  792. ;
  793. ;------------------------------------------------------------------------------
  794. ;
  795. ; Postprocessing report
  796. ;
  797. ;    7       For/Next
  798. ;    0       While/EndWhile
  799. ;    21      If/Then or If/Then/Else
  800. ;    2       Select Case
  801. ;
  802. ;------------------------------------------------------------------------------
  803. ;                 AEGiS Corp - Break the routines, code against the machines!
  804. ;------------------------------------------------------------------------------
  805.